VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FastPixels"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type

Private Type SAFEARRAY1D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 0) As SAFEARRAYBOUND
End Type

Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long


Public Function DoBlur8(PictBox As PictureBox, PBar As ProgressBar) As Byte()
    Dim pict() As Byte
    Dim sa As SAFEARRAY2D, bmp As BITMAP
    Dim r As Integer, c As Integer, value As Byte

    GetObjectAPI PictBox.Picture, Len(bmp), bmp

    If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
        MsgBox " 256-color bitmaps only", vbCritical
        Exit Function
    End If
   
    With sa
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = bmp.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = bmp.bmWidthBytes
        .pvData = bmp.bmBits
    End With
    CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
    
    PBar.Max = UBound(pict, 1) - 1
    
    ' Loop through every pixel
    For x = 1 To UBound(pict, 1) - 1
        For y = 1 To UBound(pict, 2) - 1
            ' Do calculation on pixel
            i1 = pict(x - 1, y)
            i2 = pict(x + 1, y)
            i3 = pict(x, y - 1)
            i4 = pict(x, y + 1)
            i5 = pict(x - 1, y + 1)
            i6 = pict(x + 1, y + 1)
            i7 = pict(x - 1, y - 1)
            i8 = pict(x + 1, y - 1)
            pict(x, y) = (i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8) / 8
            PBar.value = x
        Next
    Next
    
    CopyMemory ByVal VarPtrArray(pict), 0&, 4
    PictBox.Refresh
End Function

Public Function AddNoise8(Amount As Long, PictBox As PictureBox, PBar As ProgressBar) As Byte()
    Dim pict() As Byte
    Dim sa As SAFEARRAY2D, bmp As BITMAP
    Dim r As Integer, c As Integer, value As Byte

    GetObjectAPI PictBox.Picture, Len(bmp), bmp

    If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
        MsgBox " 256-color bitmaps only", vbCritical
        Exit Function
    End If
   
    With sa
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = bmp.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = bmp.bmWidthBytes
        .pvData = bmp.bmBits
    End With
    CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
    
    PBar.Max = Amount
    
    For i = 0 To Amount
        y = Int(Rnd * UBound(pict, 2))
        x = Int(Rnd * UBound(pict, 1))
        c = Int(Rnd * 255)
        pict(x, y) = c
        PBar.value = i
    Next
    
    CopyMemory ByVal VarPtrArray(pict), 0&, 4
    PictBox.Refresh
End Function
